home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 008a / perl40_2.zip / STAB.C < prev    next >
C/C++ Source or Header  |  1991-11-28  |  24KB  |  1,060 lines
  1. /* $RCSfile: stab.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:35:33 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    stab.c,v $
  9.  * Revision 4.0.1.3  91/11/05  18:35:33  lwall
  10.  * patch11: length($x) was sometimes wrong for numeric $x
  11.  * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
  12.  * patch11: *foo = undef coredumped
  13.  * patch11: solitary subroutine references no longer trigger typo warnings
  14.  * patch11: local(*FILEHANDLE) had a memory leak
  15.  *
  16.  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  17.  * patch4: new copyright notice
  18.  * patch4: added $^P variable to control calling of perldb routines
  19.  * patch4: added $^F variable to specify maximum system fd, default 2
  20.  * patch4: $` was busted inside s///
  21.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  22.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  23.  * patch4: $^D |= 1024 now does syntax tree dump at run-time
  24.  *
  25.  * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  26.  * patch1: Configure now differentiates getgroups() type from getgid() type
  27.  * patch1: you may now use "die" and "caller" in a signal handler
  28.  *
  29.  * Revision 4.0  91/03/20  01:39:41  lwall
  30.  * 4.0 baseline.
  31.  *
  32.  */
  33.  
  34.  
  35. #include "EXTERN.h"
  36. #include "perl.h"
  37.  
  38.  
  39. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  40. #include <signal.h>
  41. #endif
  42.  
  43.  
  44. static char *sig_name[] = {
  45.     SIG_NAME,0
  46. };
  47.  
  48.  
  49. #ifdef VOIDSIG
  50. #define handlertype void
  51. #else
  52. #define handlertype int
  53. #endif
  54.  
  55.  
  56. static handlertype sighandler();
  57.  
  58.  
  59. static int origalen = 0;
  60.  
  61.  
  62. STR *
  63. stab_str(str)
  64. STR *str;
  65. {
  66.     STAB *stab = str->str_u.str_stab;
  67.     register int paren;
  68.     register char *s;
  69.     register int i;
  70.  
  71.  
  72.     if (str->str_rare)
  73.     return stab_val(stab);
  74.  
  75.  
  76.     switch (*stab->str_magic->str_ptr) {
  77.     case '\004':        /* ^D */
  78. #ifdef DEBUGGING
  79.     str_numset(stab_val(stab),(double)(debug & 32767));
  80. #endif
  81.     break;
  82.     case '\006':        /* ^F */
  83.     str_numset(stab_val(stab),(double)maxsysfd);
  84.     break;
  85.     case '\t':            /* ^I */
  86.     if (inplace)
  87.         str_set(stab_val(stab), inplace);
  88.     else
  89.         str_sset(stab_val(stab),&str_undef);
  90.     break;
  91.     case '\020':        /* ^P */
  92.     str_numset(stab_val(stab),(double)perldb);
  93.     break;
  94.     case '\024':        /* ^T */
  95.     str_numset(stab_val(stab),(double)basetime);
  96.     break;
  97.     case '\027':        /* ^W */
  98.     str_numset(stab_val(stab),(double)dowarn);
  99.     break;
  100.     case '1': case '2': case '3': case '4':
  101.     case '5': case '6': case '7': case '8': case '9': case '&':
  102.     if (curspat) {
  103.         paren = atoi(stab_name(stab));
  104.       getparen:
  105.         if (curspat->spat_regexp &&
  106.           paren <= curspat->spat_regexp->nparens &&
  107.           (s = curspat->spat_regexp->startp[paren]) ) {
  108.         i = curspat->spat_regexp->endp[paren] - s;
  109.         if (i >= 0)
  110.             str_nset(stab_val(stab),s,i);
  111.         else
  112.             str_sset(stab_val(stab),&str_undef);
  113.         }
  114.         else
  115.         str_sset(stab_val(stab),&str_undef);
  116.     }
  117.     break;
  118.     case '+':
  119.     if (curspat) {
  120.         paren = curspat->spat_regexp->lastparen;
  121.         goto getparen;
  122.     }
  123.     break;
  124.     case '`':
  125.     if (curspat) {
  126.         if (curspat->spat_regexp &&
  127.           (s = curspat->spat_regexp->subbeg) ) {
  128.         i = curspat->spat_regexp->startp[0] - s;
  129.         if (i >= 0)
  130.             str_nset(stab_val(stab),s,i);
  131.         else
  132.             str_nset(stab_val(stab),"",0);
  133.         }
  134.         else
  135.         str_nset(stab_val(stab),"",0);
  136.     }
  137.     break;
  138.     case '\'':
  139.     if (curspat) {
  140.         if (curspat->spat_regexp &&
  141.           (s = curspat->spat_regexp->endp[0]) ) {
  142.         str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
  143.         }
  144.         else
  145.         str_nset(stab_val(stab),"",0);
  146.     }
  147.     break;
  148.     case '.':
  149. #ifndef lint
  150.     if (last_in_stab) {
  151.         str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  152.     }
  153. #endif
  154.     break;
  155.     case '?':
  156.     str_numset(stab_val(stab),(double)statusvalue);
  157.     break;
  158.     case '^':
  159.     s = stab_io(curoutstab)->top_name;
  160.     if (s)
  161.         str_set(stab_val(stab),s);
  162.     else {
  163.         str_set(stab_val(stab),stab_name(curoutstab));
  164.         str_cat(stab_val(stab),"_TOP");
  165.     }
  166.     break;
  167.     case '~':
  168.     s = stab_io(curoutstab)->fmt_name;
  169.     if (!s)
  170.         s = stab_name(curoutstab);
  171.     str_set(stab_val(stab),s);
  172.     break;
  173. #ifndef lint
  174.     case '=':
  175.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  176.     break;
  177.     case '-':
  178.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  179.     break;
  180.     case '%':
  181.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  182.     break;
  183. #endif
  184.     case '/':
  185.     break;
  186.     case '[':
  187.     str_numset(stab_val(stab),(double)arybase);
  188.     break;
  189.     case '|':
  190.     if (!stab_io(curoutstab))
  191.         stab_io(curoutstab) = stio_new();
  192.     str_numset(stab_val(stab),
  193.        (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  194.     break;
  195.     case ',':
  196.     str_nset(stab_val(stab),ofs,ofslen);
  197.     break;
  198.     case '\\':
  199.     str_nset(stab_val(stab),ors,orslen);
  200.     break;
  201.     case '#':
  202.     str_set(stab_val(stab),ofmt);
  203.     break;
  204.     case '!':
  205.     str_numset(stab_val(stab), (double)errno);
  206.     str_set(stab_val(stab), errno ? strerror(errno) : "");
  207.     stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  208.     break;
  209.     case '<':
  210.     str_numset(stab_val(stab),(double)uid);
  211.     break;
  212.     case '>':
  213.     str_numset(stab_val(stab),(double)euid);
  214.     break;
  215.     case '(':
  216.     s = buf;
  217.     (void)sprintf(s,"%d",(int)gid);
  218.     goto add_groups;
  219.     case ')':
  220.     s = buf;
  221.     (void)sprintf(s,"%d",(int)egid);
  222.       add_groups:
  223.     while (*s) s++;
  224. #ifdef HAS_GETGROUPS
  225. #ifndef NGROUPS
  226. #define NGROUPS 32
  227. #endif
  228.     {
  229.         GROUPSTYPE gary[NGROUPS];
  230.  
  231.  
  232.         i = getgroups(NGROUPS,gary);
  233.         while (--i >= 0) {
  234.         (void)sprintf(s," %ld", (long)gary[i]);
  235.         while (*s) s++;
  236.         }
  237.     }
  238. #endif
  239.     str_set(stab_val(stab),buf);
  240.     break;
  241.     case '*':
  242.     break;
  243.     case '0':
  244.     break;
  245.     default:
  246.     {
  247.         struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
  248.  
  249.  
  250.         if (uf && uf->uf_val)
  251.         (*uf->uf_val)(uf->uf_index, stab_val(stab));
  252.     }
  253.     break;
  254.     }
  255.     return stab_val(stab);
  256. }
  257.  
  258.  
  259. STRLEN
  260. stab_len(str)
  261. STR *str;
  262. {
  263.     STAB *stab = str->str_u.str_stab;
  264.     int paren;
  265.     int i;
  266.     char *s;
  267.  
  268.  
  269.     if (str->str_rare)
  270.     return str_len(stab_val(stab));
  271.  
  272.  
  273.     switch (*stab->str_magic->str_ptr) {
  274.     case '1': case '2': case '3': case '4':
  275.     case '5': case '6': case '7': case '8': case '9': case '&':
  276.     if (curspat) {
  277.         paren = atoi(stab_name(stab));
  278.       getparen:
  279.         if (curspat->spat_regexp &&
  280.           paren <= curspat->spat_regexp->nparens &&
  281.           (s = curspat->spat_regexp->startp[paren]) ) {
  282.         i = curspat->spat_regexp->endp[paren] - s;
  283.         if (i >= 0)
  284.             return i;
  285.         else
  286.             return 0;
  287.         }
  288.         else
  289.         return 0;
  290.     }
  291.     break;
  292.     case '+':
  293.     if (curspat) {
  294.         paren = curspat->spat_regexp->lastparen;
  295.         goto getparen;
  296.     }
  297.     break;
  298.     case '`':
  299.     if (curspat) {
  300.         if (curspat->spat_regexp &&
  301.           (s = curspat->spat_regexp->subbeg) ) {
  302.         i = curspat->spat_regexp->startp[0] - s;
  303.         if (i >= 0)
  304.             return i;
  305.         else
  306.             return 0;
  307.         }
  308.         else
  309.         return 0;
  310.     }
  311.     break;
  312.     case '\'':
  313.     if (curspat) {
  314.         if (curspat->spat_regexp &&
  315.           (s = curspat->spat_regexp->endp[0]) ) {
  316.         return (STRLEN) (curspat->spat_regexp->subend - s);
  317.         }
  318.         else
  319.         return 0;
  320.     }
  321.     break;
  322.     case ',':
  323.     return (STRLEN)ofslen;
  324.     case '\\':
  325.     return (STRLEN)orslen;
  326.     default:
  327.     return str_len(stab_str(str));
  328.     }
  329. }
  330.  
  331.  
  332. stabset(mstr,str)
  333. register STR *mstr;
  334. STR *str;
  335. {
  336.     STAB *stab;
  337.     register char *s;
  338.     int i;
  339.  
  340.  
  341.     switch (mstr->str_rare) {
  342.     case 'E':
  343.     setenv(mstr->str_ptr,str_get(str));
  344.                 /* And you'll never guess what the dog had */
  345.                 /*   in its mouth... */
  346. #ifdef TAINT
  347.     if (strEQ(mstr->str_ptr,"PATH")) {
  348.         char *strend = str->str_ptr + str->str_cur;
  349.  
  350.  
  351.         s = str->str_ptr;
  352.         while (s < strend) {
  353.         s = cpytill(tokenbuf,s,strend,':',&i);
  354.         s++;
  355.         if (*tokenbuf != '/'
  356.           || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  357.             str->str_tainted = 2;
  358.         }
  359.     }
  360. #endif
  361.     break;
  362.     case 'S':
  363.     s = str_get(str);
  364.     i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  365.     if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
  366.         warn("No such signal: SIG%s", mstr->str_ptr);
  367.     if (strEQ(s,"IGNORE"))
  368. #ifndef lint
  369.         (void)signal(i,SIG_IGN);
  370. #else
  371.         ;
  372. #endif
  373.     else if (strEQ(s,"DEFAULT") || !*s)
  374.         (void)signal(i,SIG_DFL);
  375.     else {
  376.         (void)signal(i,sighandler);
  377.         if (!index(s,'\'')) {
  378.         sprintf(tokenbuf, "main'%s",s);
  379.         str_set(str,tokenbuf);
  380.         }
  381.     }
  382.     break;
  383. #ifdef SOME_DBM
  384.     case 'D':
  385.     stab = mstr->str_u.str_stab;
  386.     hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  387.     break;
  388. #endif
  389.     case 'L':
  390.     {
  391.         CMD *cmd;
  392.  
  393.  
  394.         stab = mstr->str_u.str_stab;
  395.         i = str_true(str);
  396.         str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
  397.         cmd = str->str_magic->str_u.str_cmd;
  398.         cmd->c_flags &= ~CF_OPTIMIZE;
  399.         cmd->c_flags |= i? CFT_D1 : CFT_D0;
  400.     }
  401.     break;
  402.     case '#':
  403.     stab = mstr->str_u.str_stab;
  404.     afill(stab_array(stab), (int)str_gnum(str) - arybase);
  405.     break;
  406.     case 'X':    /* merely a copy of a * string */
  407.     break;
  408.     case '*':
  409.     s = str->str_pok ? str_get(str) : "";
  410.     if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  411.         stab = mstr->str_u.str_stab;
  412.         if (!*s) {
  413.         STBP *stbp;
  414.  
  415.  
  416.         /*SUPPRESS 701*/
  417.         (void)savenostab(stab);    /* schedule a free of this stab */
  418.         if (stab->str_len)
  419.             Safefree(stab->str_ptr);
  420.         Newz(601,stbp, 1, STBP);
  421.         stab->str_ptr = stbp;
  422.         stab->str_len = stab->str_cur = sizeof(STBP);
  423.         stab->str_pok = 1;
  424.         strcpy(stab_magic(stab),"StB");
  425.         stab_val(stab) = Str_new(70,0);
  426.         stab_line(stab) = curcmd->c_line;
  427.         stab_stash(stab) = curcmd->c_stash;
  428.         }
  429.         else {
  430.         stab = stabent(s,TRUE);
  431.         if (!stab_xarray(stab))
  432.             aadd(stab);
  433.         if (!stab_xhash(stab))
  434.             hadd(stab);
  435.         if (!stab_io(stab))
  436.             stab_io(stab) = stio_new();
  437.         }
  438.         str_sset(str, (STR*) stab);
  439.     }
  440.     break;
  441.     case 's': {
  442.         struct lstring *lstr = (struct lstring*)str;
  443.         char *tmps;
  444.  
  445.  
  446.         mstr->str_rare = 0;
  447.         str->str_magic = Nullstr;
  448.         tmps = str_get(str);
  449.         str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  450.           tmps,str->str_cur);
  451.     }
  452.     break;
  453.  
  454.  
  455.     case 'v':
  456.     do_vecset(mstr,str);
  457.     break;
  458.  
  459.  
  460.     case 0:
  461.     /*SUPPRESS 560*/
  462.     if (!(stab = mstr->str_u.str_stab))
  463.         break;
  464.     switch (*stab->str_magic->str_ptr) {
  465.     case '\004':    /* ^D */
  466. #ifdef DEBUGGING
  467.         debug = (int)(str_gnum(str)) | 32768;
  468.         if (debug & 1024)
  469.         dump_all();
  470. #endif
  471.         break;
  472.     case '\006':    /* ^F */
  473.         maxsysfd = (int)str_gnum(str);
  474.         break;
  475.     case '\t':    /* ^I */
  476.         if (inplace)
  477.         Safefree(inplace);
  478.         if (str->str_pok || str->str_nok)
  479.         inplace = savestr(str_get(str));
  480.         else
  481.         inplace = Nullch;
  482.         break;
  483.     case '\020':    /* ^P */
  484.         perldb = (int)str_gnum(str);
  485.         break;
  486.     case '\024':    /* ^T */
  487.         basetime = (long)str_gnum(str);
  488.         break;
  489.     case '\027':    /* ^W */
  490.         dowarn = (bool)str_gnum(str);
  491.         break;
  492.     case '.':
  493.         if (localizing)
  494.         savesptr((STR**)&last_in_stab);
  495.         break;
  496.     case '^':
  497.         Safefree(stab_io(curoutstab)->top_name);
  498.         stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  499.         stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  500.         break;
  501.     case '~':
  502.         Safefree(stab_io(curoutstab)->fmt_name);
  503.         stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  504.         stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  505.         break;
  506.     case '=':
  507.         stab_io(curoutstab)->page_len = (long)str_gnum(str);
  508.         break;
  509.     case '-':
  510.         stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  511.         if (stab_io(curoutstab)->lines_left < 0L)
  512.         stab_io(curoutstab)->lines_left = 0L;
  513.         break;
  514.     case '%':
  515.         stab_io(curoutstab)->page = (long)str_gnum(str);
  516.         break;
  517.     case '|':
  518.         if (!stab_io(curoutstab))
  519.         stab_io(curoutstab) = stio_new();
  520.         stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  521.         if (str_gnum(str) != 0.0) {
  522.         stab_io(curoutstab)->flags |= IOF_FLUSH;
  523.         }
  524.         break;
  525.     case '*':
  526.         i = (int)str_gnum(str);
  527.         multiline = (i != 0);
  528.         break;
  529.     case '/':
  530.         if (str->str_pok) {
  531.         rs = str_get(str);
  532.         rslen = str->str_cur;
  533.         if (!rslen) {
  534.             rs = "\n\n";
  535.             rslen = 2;
  536.         }
  537.         rschar = rs[rslen - 1];
  538.         }
  539.         else {
  540.         rschar = 0777;    /* fake a non-existent char */
  541.         rslen = 1;
  542.         }
  543.         break;
  544.     case '\\':
  545.         if (ors)
  546.         Safefree(ors);
  547.         ors = savestr(str_get(str));
  548.         orslen = str->str_cur;
  549.         break;
  550.     case ',':
  551.         if (ofs)
  552.         Safefree(ofs);
  553.         ofs = savestr(str_get(str));
  554.         ofslen = str->str_cur;
  555.         break;
  556.     case '#':
  557.         if (ofmt)
  558.         Safefree(ofmt);
  559.         ofmt = savestr(str_get(str));
  560.         break;
  561.     case '[':
  562.         arybase = (int)str_gnum(str);
  563.         break;
  564.     case '?':
  565.         statusvalue = U_S(str_gnum(str));
  566.         break;
  567.     case '!':
  568.         errno = (int)str_gnum(str);        /* will anyone ever use this? */
  569.         break;
  570.     case '<':
  571.         uid = (int)str_gnum(str);
  572. #if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
  573.         if (delaymagic) {
  574.         delaymagic |= DM_REUID;
  575.         break;                /* don't do magic till later */
  576.         }
  577. #endif /* HAS_SETREUID or not HASSETRUID */
  578. #ifdef HAS_SETRUID
  579.         if (setruid((UIDTYPE)uid) < 0)
  580.         uid = (int)getuid();
  581. #else
  582. #ifdef HAS_SETREUID
  583.         if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
  584.         uid = (int)getuid();
  585. #else
  586.         if (uid == euid)        /* special case $< = $> */
  587.         setuid(uid);
  588.         else
  589.         fatal("setruid() not implemented");
  590. #endif
  591. #endif
  592.         break;
  593.     case '>':
  594.         euid = (int)str_gnum(str);
  595. #if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
  596.         if (delaymagic) {
  597.         delaymagic |= DM_REUID;
  598.         break;                /* don't do magic till later */
  599.         }
  600. #endif /* HAS_SETREUID or not HAS_SETEUID */
  601. #ifdef HAS_SETEUID
  602.         if (seteuid((UIDTYPE)euid) < 0)
  603.         euid = (int)geteuid();
  604. #else
  605. #ifdef HAS_SETREUID
  606.         if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
  607.         euid = (int)geteuid();
  608. #else
  609.         if (euid == uid)        /* special case $> = $< */
  610.         setuid(euid);
  611.         else
  612.         fatal("seteuid() not implemented");
  613. #endif
  614. #endif
  615.         break;
  616.     case '(':
  617.         gid = (int)str_gnum(str);
  618. #if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
  619.         if (delaymagic) {
  620.         delaymagic |= DM_REGID;
  621.         break;                /* don't do magic till later */
  622.         }
  623. #endif /* HAS_SETREGID or not HAS_SETRGID */
  624. #ifdef HAS_SETRGID
  625.         (void)setrgid((GIDTYPE)gid);
  626. #else
  627. #ifdef HAS_SETREGID
  628.         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
  629. #else
  630.         fatal("setrgid() not implemented");
  631. #endif
  632. #endif
  633.         break;
  634.     case ')':
  635.         egid = (int)str_gnum(str);
  636. #if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
  637.         if (delaymagic) {
  638.         delaymagic |= DM_REGID;
  639.         break;                /* don't do magic till later */
  640.         }
  641. #endif /* HAS_SETREGID or not HAS_SETEGID */
  642. #ifdef HAS_SETEGID
  643.         (void)setegid((GIDTYPE)egid);
  644. #else
  645. #ifdef HAS_SETREGID
  646.         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
  647. #else
  648.         fatal("setegid() not implemented");
  649. #endif
  650. #endif
  651.         break;
  652.     case ':':
  653.         chopset = str_get(str);
  654.         break;
  655.     case '0':
  656.         if (!origalen) {
  657.         s = origargv[0];
  658.         s += strlen(s);
  659.         /* See if all the arguments are contiguous in memory */
  660.         for (i = 1; i < origargc; i++) {
  661.             if (origargv[i] == s + 1)
  662.             s += strlen(++s);    /* this one is ok too */
  663.         }
  664.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  665.             setenv("NoNeSuCh", Nullch);    /* force copy of environment */
  666.             for (i = 0; origenviron[i]; i++)
  667.             if (origenviron[i] == s + 1)
  668.                 s += strlen(++s);
  669.         }
  670.         origalen = s - origargv[0];
  671.         }
  672.         s = str_get(str);
  673.         i = str->str_cur;
  674.         if (i >= origalen) {
  675.         i = origalen;
  676.         str->str_cur = i;
  677.         str->str_ptr[i] = '\0';
  678.         bcopy(s, origargv[0], i);
  679.         }
  680.         else {
  681.         bcopy(s, origargv[0], i);
  682.         s = origargv[0]+i;
  683.         *s++ = '\0';
  684.         while (++i < origalen)
  685.             *s++ = ' ';
  686.         }
  687.         break;
  688.     default:
  689.         {
  690.         struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
  691.  
  692.  
  693.         if (uf && uf->uf_set)
  694.             (*uf->uf_set)(uf->uf_index, str);
  695.         }
  696.         break;
  697.     }
  698.     break;
  699.     }
  700. }
  701.  
  702.  
  703. whichsig(sig)
  704. char *sig;
  705. {
  706.     register char **sigv;
  707.  
  708.  
  709.     for (sigv = sig_name+1; *sigv; sigv++)
  710.     if (strEQ(sig,*sigv))
  711.         return sigv - sig_name;
  712. #ifdef SIGCLD
  713.     if (strEQ(sig,"CHLD"))
  714.     return SIGCLD;
  715. #endif
  716. #ifdef SIGCHLD
  717.     if (strEQ(sig,"CLD"))
  718.     return SIGCHLD;
  719. #endif
  720.     return 0;
  721. }
  722.  
  723.  
  724. static handlertype
  725. sighandler(sig)
  726. int sig;
  727. {
  728.     STAB *stab;
  729.     STR *str;
  730.     int oldsave = savestack->ary_fill;
  731.     int oldtmps_base = tmps_base;
  732.     register CSV *csv;
  733.     SUBR *sub;
  734.  
  735.  
  736. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  737.     signal(sig, SIG_ACK);
  738. #endif
  739.     stab = stabent(
  740.     str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  741.       TRUE)), TRUE);
  742.     sub = stab_sub(stab);
  743.     if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  744.     if (sig_name[sig][1] == 'H')
  745.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  746.           TRUE);
  747.     else
  748.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  749.           TRUE);
  750.     sub = stab_sub(stab);    /* gag */
  751.     }
  752.     if (!sub) {
  753.     if (dowarn)
  754.         warn("SIG%s handler \"%s\" not defined.\n",
  755.         sig_name[sig], stab_name(stab) );
  756.     return;
  757.     }
  758.     /*SUPPRESS 701*/
  759.     saveaptr(&stack);
  760.     str = Str_new(15, sizeof(CSV));
  761.     str->str_state = SS_SCSV;
  762.     (void)apush(savestack,str);
  763.     csv = (CSV*)str->str_ptr;
  764.     csv->sub = sub;
  765.     csv->stab = stab;
  766.     csv->curcsv = curcsv;
  767.     csv->curcmd = curcmd;
  768.     csv->depth = sub->depth;
  769.     csv->wantarray = G_SCALAR;
  770.     csv->hasargs = TRUE;
  771.     csv->savearray = stab_xarray(defstab);
  772.     csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
  773.     stack->ary_flags = 0;
  774.     curcsv = csv;
  775.     str = str_mortal(&str_undef);
  776.     str_set(str,sig_name[sig]);
  777.     (void)apush(stab_xarray(defstab),str);
  778.     sub->depth++;
  779.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  780.     if (sub->depth == 100 && dowarn)
  781.         warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  782.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  783.     }
  784.  
  785.  
  786.     tmps_base = tmps_max;        /* protect our mortal string */
  787.     (void)cmd_exec(sub->cmd,G_SCALAR,0);        /* so do it already */
  788.     tmps_base = oldtmps_base;
  789.  
  790.  
  791.     restorelist(oldsave);        /* put everything back */
  792. }
  793.  
  794.  
  795. STAB *
  796. aadd(stab)
  797. register STAB *stab;
  798. {
  799.     if (!stab_xarray(stab))
  800.     stab_xarray(stab) = anew(stab);
  801.     return stab;
  802. }
  803.  
  804.  
  805. STAB *
  806. hadd(stab)
  807. register STAB *stab;
  808. {
  809.     if (!stab_xhash(stab))
  810.     stab_xhash(stab) = hnew(COEFFSIZE);
  811.     return stab;
  812. }
  813.  
  814.  
  815. STAB *
  816. fstab(name)
  817. char *name;
  818. {
  819.     char tmpbuf[1200];
  820.     STAB *stab;
  821.  
  822.  
  823.     sprintf(tmpbuf,"'_<%s", name);
  824.     stab = stabent(tmpbuf, TRUE);
  825.     str_set(stab_val(stab), name);
  826.     if (perldb)
  827.     (void)hadd(aadd(stab));
  828.     return stab;
  829. }
  830.  
  831.  
  832. STAB *
  833. stabent(name,add)
  834. register char *name;
  835. int add;
  836. {
  837.     register STAB *stab;
  838.     register STBP *stbp;
  839.     int len;
  840.     register char *namend;
  841.     HASH *stash;
  842.     char *sawquote = Nullch;
  843.     char *prevquote = Nullch;
  844.     bool global = FALSE;
  845.  
  846.  
  847.     if (isUPPER(*name)) {
  848.     if (*name > 'I') {
  849.         if (*name == 'S' && (
  850.           strEQ(name, "SIG") ||
  851.           strEQ(name, "STDIN") ||
  852.           strEQ(name, "STDOUT") ||
  853.           strEQ(name, "STDERR") ))
  854.         global = TRUE;
  855.     }
  856.     else if (*name > 'E') {
  857.         if (*name == 'I' && strEQ(name, "INC"))
  858.         global = TRUE;
  859.     }
  860.     else if (*name > 'A') {
  861.         if (*name == 'E' && strEQ(name, "ENV"))
  862.         global = TRUE;
  863.     }
  864.     else if (*name == 'A' && (
  865.       strEQ(name, "ARGV") ||
  866.       strEQ(name, "ARGVOUT") ))
  867.         global = TRUE;
  868.     }
  869.     for (namend = name; *namend; namend++) {
  870.     if (*namend == '\'' && namend[1])
  871.         prevquote = sawquote, sawquote = namend;
  872.     }
  873.     if (sawquote == name && name[1]) {
  874.     stash = defstash;
  875.     sawquote = Nullch;
  876.     name++;
  877.     }
  878.     else if (!isALPHA(*name) || global)
  879.     stash = defstash;
  880.     else if ((CMD*)curcmd == &compiling)
  881.     stash = curstash;
  882.     else
  883.     stash = curcmd->c_stash;
  884.     if (sawquote) {
  885.     char tmpbuf[256];
  886.     char *s, *d;
  887.  
  888.  
  889.     *sawquote = '\0';
  890.     /*SUPPRESS 560*/
  891.     if (s = prevquote) {
  892.         strncpy(tmpbuf,name,s-name+1);
  893.         d = tmpbuf+(s-name+1);
  894.         *d++ = '_';
  895.         strcpy(d,s+1);
  896.     }
  897.     else {
  898.         *tmpbuf = '_';
  899.         strcpy(tmpbuf+1,name);
  900.     }
  901.     stab = stabent(tmpbuf,TRUE);
  902.     if (!(stash = stab_xhash(stab)))
  903.         stash = stab_xhash(stab) = hnew(0);
  904.     if (!stash->tbl_name)
  905.         stash->tbl_name = savestr(name);
  906.     name = sawquote+1;
  907.     *sawquote = '\'';
  908.     }
  909.     len = namend - name;
  910.     stab = (STAB*)hfetch(stash,name,len,add);
  911.     if (stab == (STAB*)&str_undef)
  912.     return Nullstab;
  913.     if (stab->str_pok) {
  914.     stab->str_pok |= SP_MULTI;
  915.     return stab;
  916.     }
  917.     else {
  918.     if (stab->str_len)
  919.         Safefree(stab->str_ptr);
  920.     Newz(602,stbp, 1, STBP);
  921.     stab->str_ptr = stbp;
  922.     stab->str_len = stab->str_cur = sizeof(STBP);
  923.     stab->str_pok = 1;
  924.     strcpy(stab_magic(stab),"StB");
  925.     stab_val(stab) = Str_new(72,0);
  926.     stab_line(stab) = curcmd->c_line;
  927.     str_magic((STR*)stab, stab, '*', name, len);
  928.     stab_stash(stab) = stash;
  929.     if (isDIGIT(*name) && *name != '0') {
  930.         stab_flags(stab) = SF_VMAGIC;
  931.         str_magic(stab_val(stab), stab, 0, Nullch, 0);
  932.     }
  933.     if (add & 2)
  934.         stab->str_pok |= SP_MULTI;
  935.     return stab;
  936.     }
  937. }
  938.  
  939.  
  940. stab_fullname(str,stab)
  941. STR *str;
  942. STAB *stab;
  943. {
  944.     HASH *tb = stab_stash(stab);
  945.  
  946.  
  947.     if (!tb)
  948.     return;
  949.     str_set(str,tb->tbl_name);
  950.     str_ncat(str,"'", 1);
  951.     str_scat(str,stab->str_magic);
  952. }
  953.  
  954.  
  955. STIO *
  956. stio_new()
  957. {
  958.     STIO *stio;
  959.  
  960.  
  961.     Newz(603,stio,1,STIO);
  962.     stio->page_len = 60;
  963.     return stio;
  964. }
  965.  
  966.  
  967. stab_check(min,max)
  968. int min;
  969. register int max;
  970. {
  971.     register HENT *entry;
  972.     register int i;
  973.     register STAB *stab;
  974.  
  975.  
  976.     for (i = min; i <= max; i++) {
  977.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  978.         stab = (STAB*)entry->hent_val;
  979.         if (stab->str_pok & SP_MULTI)
  980.         continue;
  981.         curcmd->c_line = stab_line(stab);
  982.         warn("Possible typo: \"%s\"", stab_name(stab));
  983.     }
  984.     }
  985. }
  986.  
  987.  
  988. static int gensym = 0;
  989.  
  990.  
  991. STAB *
  992. genstab()
  993. {
  994.     (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  995.     return stabent(tokenbuf,TRUE);
  996. }
  997.  
  998.  
  999. /* hopefully this is only called on local symbol table entries */
  1000.  
  1001.  
  1002. void
  1003. stab_clear(stab)
  1004. register STAB *stab;
  1005. {
  1006.     STIO *stio;
  1007.     SUBR *sub;
  1008.  
  1009.  
  1010.     afree(stab_xarray(stab));
  1011.     stab_xarray(stab) = Null(ARRAY*);
  1012.     (void)hfree(stab_xhash(stab), FALSE);
  1013.     stab_xhash(stab) = Null(HASH*);
  1014.     str_free(stab_val(stab));
  1015.     stab_val(stab) = Nullstr;
  1016.     /*SUPPRESS 560*/
  1017.     if (stio = stab_io(stab)) {
  1018.     do_close(stab,FALSE);
  1019.     Safefree(stio->top_name);
  1020.     Safefree(stio->fmt_name);
  1021.     Safefree(stio);
  1022.     }
  1023.     /*SUPPRESS 560*/
  1024.     if (sub = stab_sub(stab)) {
  1025.     afree(sub->tosave);
  1026.     cmd_free(sub->cmd);
  1027.     }
  1028.     Safefree(stab->str_ptr);
  1029.     stab->str_ptr = Null(STBP*);
  1030.     stab->str_len = 0;
  1031.     stab->str_cur = 0;
  1032. }
  1033.  
  1034.  
  1035. #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
  1036. #define MICROPORT
  1037. #endif
  1038.  
  1039.  
  1040. #ifdef    MICROPORT    /* Microport 2.4 hack */
  1041. ARRAY *stab_array(stab)
  1042. register STAB *stab;
  1043. {
  1044.     if (((STBP*)(stab->str_ptr))->stbp_array)
  1045.     return ((STBP*)(stab->str_ptr))->stbp_array;
  1046.     else
  1047.     return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
  1048. }
  1049.  
  1050.  
  1051. HASH *stab_hash(stab)
  1052. register STAB *stab;
  1053. {
  1054.     if (((STBP*)(stab->str_ptr))->stbp_hash)
  1055.     return ((STBP*)(stab->str_ptr))->stbp_hash;
  1056.     else
  1057.     return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
  1058. }
  1059. #endif            /* Microport 2.4 hack */
  1060.